home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr35 / shift103.zip / SHIFTEM.PAS < prev   
Pascal/Delphi Source File  |  1993-04-20  |  5KB  |  183 lines
  1. Program Shiftem;
  2.  
  3. {
  4. ****************************************************************************
  5. Multiline support for Binkley (checking and generation of .BSY files) will
  6. be coming soon once I have finished the other projects I'm working on.
  7. At the moment running in a busy multiline environment could seriously damage
  8. your .?LO files.
  9. ****************************************************************************
  10.  
  11. 1.02  15/05/93  Added support for Zmail which seems to use a non standard
  12.                 LF for end of line instead of the more usual CR+LF!
  13. 1.03  19/05/93  Added support for Binkley Multiline .BSY flags.                
  14. }
  15.  
  16. Uses Dos;
  17.  
  18. Const
  19.   ProgName = 'ShiftEm';
  20.   Vers = '1.03';
  21.   Date = 'Mon 19th April 1993';
  22.   MaxDirSize = 512;
  23.  
  24. type
  25.   TextPtr  = ^TextRec;
  26.   TextRec  = record
  27.                Txtline : String;
  28.              end;
  29.  
  30.   DirPtr   = ^DirRec;
  31.   DirRec   = record
  32.                Attr: Byte;
  33.                Time: Longint;
  34.                Size: Longint;
  35.                Name: string[12];
  36.              end;
  37.   DirList  = array[0..MaxDirSize - 1] of DirPtr;
  38.   TextList = array[0..999] of TextPtr;
  39.  
  40. Var
  41.   ScanPath : PathStr;
  42.   TxtCnt,
  43.   Count : Integer;
  44.   Txt : TextList;
  45.   Dir : DirList;
  46.  
  47.  
  48. Procedure DoWork(Spath : PathStr);
  49.  
  50. procedure FindFiles;
  51. var
  52.   F: SearchRec;
  53. begin
  54.   Count := 0;
  55.   FindFirst(SPath, Archive, F);
  56.   while (DosError = 0) and (Count < MaxDirSize) do
  57.   begin
  58.     GetMem(Dir[Count], Length(F.Name) + 10);
  59.     Move(F.Attr, Dir[Count]^, Length(F.Name) + 10);
  60.     Inc(Count);
  61.     FindNext(F);
  62.   end;
  63. end;
  64.  
  65. Var
  66.  t       : Text;
  67.  b       : File;
  68.  i, j, k : Integer;
  69.  s       : String;
  70.  ArcMail,
  71.  Change  : Boolean;
  72.  DirInfo : SearchRec;
  73.  D       : DirStr;
  74.  N       : NameStr;
  75.  E       : ExtStr;
  76.  
  77. begin
  78.  FindFiles;
  79.  If Count = 0 then
  80.   begin
  81.    WriteLn;
  82.    WriteLn('Nothing to Do!!!');
  83.    Halt(2);
  84.   end;
  85.  For i := 0 to Count -1 do
  86.   Begin
  87.    Fsplit(ScanPath+Dir[i]^.Name, D, N, E);
  88.    FindFirst(D+N+'.BSY', Archive, Dirinfo);
  89.    if ((DosError = 2) or (DosError = 18)) then
  90.     Begin
  91.      FileMode:=$21; {DenyWrite - Write Only}
  92.      Assign(b, D+N+'.BSY');
  93.      {$I-} Rewrite(b); {$I+}
  94.      if IOResult = 0 then
  95.       Begin
  96.        TxtCnt:=0;
  97.        Assign(t, D+N+E);
  98.        FileMode:=$42; {DenyNone - Read/Write}
  99.        {$I-} Reset(t); {$I+}
  100.        if IOResult = 0 then
  101.         While (Not Eof(t)) do
  102.          Begin
  103.           Readln(t, S);
  104.           While (S <> '') do
  105.            Begin
  106.             New(Txt[TxtCnt]);
  107.             k := pos(#10,S);
  108.             if k <> 0 then
  109.              Begin
  110.               Txt[TxtCnt]^.TxtLine := Copy(S,1,k-1);
  111.               S := Copy(S,k+1,Length(s)-k);
  112.              end {if k <> 0}
  113.             else
  114.              Begin
  115.               Txt[TxtCnt]^.TxtLine := S;
  116.               S := '';
  117.              end; {if k <> 0}
  118.             Inc(TxtCnt);
  119.            end; {While S <> ''}
  120.          end; {While Not Eof(t)}
  121.        k:=0;
  122.        Change:=False;
  123.        if TxtCnt <> 0 then
  124.         for j := 0 to TxtCnt -1 do
  125.          Begin
  126.           S := Copy(Txt[j]^.Txtline,Length(Txt[j]^.Txtline)-2,2);
  127.           S := Upcase(S[1]) + Upcase(S[2]);
  128.           if (S = 'MO') or
  129.              (S = 'TU') or
  130.              (S = 'WE') or
  131.              (S = 'TH') or
  132.              (S = 'FR') or
  133.              (S = 'SA') or
  134.              (S = 'SU') or
  135.              (S = 'TZ') then ArcMail := True
  136.           else ArcMail:=False;
  137.           if ArcMail and (j = k) then Inc(k);
  138.           If ArcMail and (J > K) then
  139.            Begin
  140.             S:= Txt[k]^.Txtline;
  141.             Txt[k]^.TxtLine := Txt[j]^.TxtLine;
  142.             Txt[j]^.TxtLine := S;
  143.             Inc(k);
  144.             Change:=True;
  145.            end; {if Arcmail and J > K}
  146.          end; {For}
  147.        if Change then
  148.         Begin
  149.          Rewrite(t);
  150.          For j := 0 to TxtCnt -1 do
  151.           WriteLn(t,Txt[j]^.TxtLine);
  152.          While ((TxtCnt-1) <> 0) do
  153.           Begin
  154.            Dispose(Txt[TxtCnt-1]);
  155.            Dec(TxtCnt);
  156.           end; {While}
  157.         end; {if Change}
  158.        Close(t);
  159.       end; {if IOResult = 0}
  160.      Close(b);
  161.      Erase(b);
  162.     end; {If DOSerror = 0}
  163.   end; {For i := 0 to Count}
  164. end; {DoWork}
  165.  
  166. Procedure Usage;
  167. begin
  168.  Writeln('Usage: ');
  169.  WriteLn('Progname <Drive:path\> of outbound area to scan.');
  170.  WriteLn;
  171.  Halt(1);
  172. end;
  173.  
  174. begin
  175.  Writeln;
  176.  Writeln(ProgName+' Vers: '+vers+'    Compiled: '+Date+'  (C) Dave Gorski');
  177.  if Paramcount <> 1 then usage;
  178.  ScanPath := ParamStr(1);
  179.  if ScanPath[length(ScanPath)] <> '\' then
  180.   ScanPath := ScanPath + '\';
  181.  dowork(ScanPath+'*.?LO');
  182. end.
  183.